perm filename TAPDPY.F4[TAP,LCS] blob
sn#341726 filedate 1978-03-15 generic text, type T, neo UTF8
C THIS IS FOR RHYTHMIC INPUT FROM TTY KEYBOARD.
C ORDER FOR EDITING WITH 'CONDUCT'.
C 1. GET LISTING. 2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.
C 3. QUICK TEMPO CHANGES MUST COME LAST!
DIMENSION IV(200),V(200),W(600),VV(5),RV(8),JV(25)
1,DPY(2000)
COMMON V,N
EQUIVALENCE (VV1,VV(1)),(VV2,VV(2)),(VV3,VV(3))
1 ,(VV4,VV(4)),(VV5,VV(5)),(JV,RV,IV)
1032 TYPE 1000
32 X=0
I=1
J=1
JOUT=5
C 5 = OUTPUT TO TTY
1000 FORMAT(' INFO? OR WHAT?'/)
ACCEPT 50,N,NN
50 FORMAT(2A1)
IF(N.NE.'I')GO TO 2000
TYPE 2000
GO TO 1032
2000 FORMAT
1(' COMMANDS: <CR>=TAP, C(ONDUCT), L(IST), LR=LIST RHYTHM,
1 LP=LIST ON LPT'/' S(AVE A FILE), R(EAD AN OLD FILE),
1 E(DIT)'/' ALL RESTS, AS WELL AS NOTES, MUST BE
1 TAPPED.'/)
IF(N.EQ.'L')GO TO 24
IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
IF(N.EQ.'E')GO TO 1013
IF(N.EQ.'C')TYPE 209
3001 TYPE 1001
209 FORMAT(' CONDUCTOR MUST GIVE UPBEAT.')
1001 FORMAT(' TAP ON CNTRL OR META. END WITH "TOP"'/)
DO 2001 K=1,200
2001 V(K)=0
CALL TAP(V)
CC DO 2001 K=II+1,200
CC2001 V(K)=0
A=0
L=1
IF(N.EQ.'C')L=2
DO 1021 K=L,200
IF(V(K).EQ.0)GO TO 3021
1021 A=A+V(K)
2021 FORMAT(I4,' TAPS ',F8.3,'"'/)
K=201
3021 L=K-1
II=L
IF(N.EQ.'C')L=L-1
CCC IF(N.EQ.'C')L=L-1
TYPE 2021,L,A
21 FORMAT(2F)
TYPE 12
12 FORMAT(' <CR>=OK, 1=TRY AGAIN, L=LIST'/)
ACCEPT 5,K
ICON=0
IF(K.EQ.1)GO TO 3001
REREAD 50,K,NN
C YOU CAN TYPE L FOR LIST AT THIS POINT.
IF(N.NE.'C')GO TO 4012
C WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
C METER OF UPBEAT (NOTE #0) MAY BE RESET.
ALLM=1.
ICON=-1
3012 Q=ALLM
DO 2012 KA=3,II*3,3
2012 W(KA)=Q
IF(ALLM.EQ.X)GO TO 300
4012 IF(K.NE.'L')GO TO 1032
N='L'
24 IF(NN.EQ.'P')JOUT=3
C 3 = OUTPUT TO LPT (TYPE LP)
IF(ICON)GO TO 100
9024 N=0
7024 FORMAT(/' DURATIONS OF TAPS',18XA5,' TOTAL=',F7.3,' SECS.'/)
8024 FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
315 FORMAT(' HOW MANY(K) NTHS IN FIRST TAP? TYPE K AND N. '$)
RHY=0
IF(NN.NE.'R')GO TO 215
TYPE 315
ACCEPT 21,RHY,VVV
IF(VVV.EQ.0)VVV=16
RHY=V(1)*VVV/RHY
215 L=1
K=1
IF(ICON)K=0
WRITE(JOUT,7024),QSLAC,A
IF(ICON)WRITE(JOUT, 8024)
DO 14 LL=1,40
KA=K+1
KB=KA+1
KC=KB+1
KD=KC+1
DO 115 KK=0,4
VVV=V(L+KK)
IF(RHY.GT.0)VVV=RHY/VVV
C CONVERTS TO RHYTHMIC DENOMINATORS
115 VV(KK+1)=VVV
WRITE(JOUT,15)K,VV1,KA,VV2,KB,VV3,KC,VV4,KD,VV5
DO 16 M=1,5
B=V(L+M+1)
IF(B.EQ.0.OR.B.EQ.999.0)GO TO 15
16 CONTINUE
L=L+5
14 K=K+5
15 FORMAT(5(' (',I3,')',F7.3)/)
IF(JOUT.EQ.5)GO TO 1032
CALL EXIT
1013 TYPE 17
IF(ICON.GE.0)GO TO 17
IF(ICON.EQ.-2)Q=W(3)
C GETS FIRST METER INDICATION.
ICON=-1
17 FORMAT(' TYPE C(HANGE),A(DD NOTE),D(ELETE),T(EMPO CHANGE),
1M(ETER CHANGE),Q(UICK CHANGE), OR <CR>'/)
ACCEPT 50,K
IF(K.EQ.'-1')GO TO 1013
C WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
IF(K.EQ.'M')GO TO 101
IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
TYPE 19
19 FORMAT(' TYPE NOTE N'/)
ACCEPT 5,KA
IF(KA)GO TO 1013
IF(K.EQ.'Q')GO TO 120
L=KA
IF(ICON)KA=KA+1
TYPE 20,L,V(KA)
20 FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
X=V(KA)
ACCEPT 21,V(KA)
IF(V(KA).LE.0)V(KA)=X
A=A+V(KA)-X
IF(ICON+1)GO TO 300
GO TO 1013
220 FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
1 ' CHANGE TF1 TO ',$)
120 L=KA*3+1
TYPE 220,KA,W(L),W(L+1)
ACCEPT 21,Y
IF(Y.LE.0)GO TO 1013
X=W(L+1)+W(L)-Y
W(L)=Y
W(L+1)=X
KA=KA+2
LA=L+2
GO TO 1300
C QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
C THEY MUST BE IN ORDER FROM 1 TO END.
18 IF(K.NE.'A')GO TO 22
TYPE 23
23 FORMAT(' ADD AFTER WHICH NOTE?'/)
ACCEPT 5,K
IF(K)GO TO 1013
IF(ICON)K=K+1
TYPE 25
25 FORMAT(' TYPE NOTE VALUE'/)
ACCEPT 21,X
IF(X.LE.0)GO TO 18
A=A+X
II=II+1
IF(ICON)W((II-1)*3)=1.
L=II+10
DO 26 M=L,1,-1
V(M)=V(M-1)
IF(M-1.NE.K)GO TO 26
V(M)=X
C 'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
IF(ICON)GO TO 2300
GO TO 1013
26 CONTINUE
GO TO 1032
22 IF(K.NE.'D')GO TO 35
TYPE 28
28 FORMAT(' DELETE WHICH NOTE?'/)
ACCEPT 5,K
IF(K)GO TO 1013
IF(ICON)K=K+1
II=II-1
A=A-V(K)
DO 29 KA=K,II-1
29 V(KA)=V(KA+1)
IF(ICON)GO TO 2300
GO TO 1013
410 KB=II
KC=II
KA=1
KX=4
CC1410 G=3.9
CC MM=234
CC ICNT=1
1410 KD=36
CALL DPYSET(1,DPY,2000)
CALL AIVECT(-400,0)
J=-405
DO 210 K=4,KC*3,3
L=W(K)*100-100
J=J+5
CALL AVECT(J,L)
L=W(K+1)*100-100
J=J+5
210 CALL AVECT(J,L)
CALL DPYOUT(1)
GO TO 9024
2410 FORMAT(/ )
1110 FORMAT(1XA1,'=',I2,' 16TH NOTES')
35 FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
IF(K.NE.'T')GO TO 1032
TYPE 35
ACCEPT 21,X
IF(X)GO TO 1013
A=0
IF(ICON)A=-V(1)/X
DO 36 K=1,II
V(K)=V(K)/X
36 A=A+V(K)
IF(ICON)GO TO 2300
GO TO 1032
100 IF(ICON+1)GO TO 410
2300 W(1)=980000.
300 W(2)=II*3-2
KA=2
LA=3
X=Q/V(1)
1300 L=LA
DO 1200 K=KA,II
Y=W(L)/V(K)
W(L+1)=Y
W(L+2)=Y
1200 L=L+3
L=LA
3300 DO 500 K=KA,II
Y=W(L)/V(K)
Z=Y
IF(K.LT.II)Z=W(L+4)
B=ABS(Y-X)
C=ABS(Z-Y)
D=B-C/2
IF(Y-X)GO TO 700
IF(Z-Y)GO TO 900
IF(D)GO TO 600
IF(C.GE..05)B=-D
IF(C.LT..05)B=-B*.1
C '.1' IS ARBITRARY. TO SMOOTH JUMPS IN TEMPO.
GO TO 200
700 IF(Z-Y.LE.0)GO TO 800
B=B*.5
GO TO 200
800 IF(D)GO TO 200
IF(C.GE..05)B=D
IF(C.LT..05)B=B*.1
GO TO 200
900 B=-B*.5
GO TO 200
600 B=-B
200 W(L+1)=W(L+1)+B
W(L+2)=W(L+2)-B
X=W(L+2)
500 L=L+3
L=L-1
DO 2100 K=1,7
2100 W(L+K)=999.
ICON=-2
IF(N.EQ.'L')GO TO 410
IF(N.EQ.'E')GO TO 1013
GO TO 2
CCC101 FORMAT(' CHANGE WHICH BEAT?'/)
101 FORMAT(' TYPE TAP NUMBER AND NEW VALUE'/)
TYPE 101
CCC ACCEPT 5,KA
ACCEPT 201,KA,RV
C I.E. 3/8 = 4,8 OR 4. (DOT); 5/16 = 4,16 3/16=8. (DOT)
CCC TYPE 201
CCC201 FORMAT(' TYPE VALUE OF BEAT'/)
201 FORMAT(I,8F)
X=0
CCC ACCEPT 5,(IV(K),K=1,8)
DO 301 K=1,8
Y=RV(K)
IF(Y.LT.99.)GO TO 301
ALLM=X
GO TO 3012
C SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
301 IF(Y.NE.0)X=X+4./Y
REREAD 2201,JV
IDOT=0
DO 3201 K=1,25
C FINDS DOTTED VALUES FOR METER CHANGE.
3201 IF(JV(K).EQ.'.')IDOT=IDOT+1
Y=X
4201 IF(IDOT.EQ.0)GO TO 1201
C JUMP IF NO DOTS
Y=Y/2
X=X+Y
IDOT=IDOT-1
GO TO 4201
1201 W(KA*3)=X
GO TO 300
2201 FORMAT(25A1)
C FIX SO CHANGES GO FROM THIS POINT ON.
CC THE NEXT WILL BE OUT.
CX W(L+2)=(X/V(KA-1)-Y)*2+Y
CX W(L+4)=W(L+2)
C QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY METER CHANGE.
CX GO TO 1013
6 TYPE 2
IF(N.EQ.'R')ICON=0
IF(ICON.EQ.-1)GO TO 100
2 FORMAT(' TYPE FILE NAME'/)
ACCEPT 4,QSLAC
IF(QSLAC.EQ.'-1')GO TO 1032
IF(QSLAC.NE.' ')GO TO 4
QSLAC='TAP'
4 FORMAT(A5)
5 FORMAT(8I)
CC CALL ZERPP
IF(ICON)GO TO 1005
IF(N.EQ.'R') GO TO 27
DO 102 K=1,II+10
102 W(K)=V(K)
1005 CALL OFILE(1,QSLAC)
10 DO 7 K=1,7
IF(W(I).EQ.0)W(I)=999.0
7 I=I+1
8 WRITE(1,11)(W(K),K=J,J+6)
IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
J=I
GO TO 10
C 'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
9 WRITE(1)II,A,V,Q
TYPE 109,QSLAC
END FILE 1
CALL EXIT
109 FORMAT(' *****TAPS SAVED IN***** ',A5,'.DAT')
27 CALL IFILE(1,QSLAC)
30 READ(1,11)(W(K),K=J,J+6)
IF(W(J+6).EQ.999.0)GO TO 6013
J=J+7
GO TO 30
6013 READ(1)II,A,V,Q
IF(W(1).GT.999.)ICON=-2
GO TO 1032
11 FORMAT(1X7F)
END